home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / emacs_src_18_58.lha / emacs-18.58 / lisp / ada.el < prev    next >
Lisp/Scheme  |  1992-02-21  |  20KB  |  618 lines
  1. ; Ada editing support package in GNUlisp.  v1.0
  2. ; Author: Vincent Broman <broman@bugs.nosc.mil>  May 1987.
  3. ; (borrows heavily from Mick Jordan's Modula-2 package for GNU,
  4. ; as modified by Peter Robinson, Michael Schmidt, and Tom Perrine.)
  5.  
  6.  
  7. (setq auto-mode-alist (cons (cons "\\.ada$" 'ada-mode) auto-mode-alist))
  8.  
  9. (defvar ada-mode-syntax-table nil
  10.   "Syntax table in use in Ada-mode buffers.")
  11.  
  12. (let ((table (make-syntax-table)))
  13.   (modify-syntax-entry ?_ "_" table)
  14.   (modify-syntax-entry ?\# "_" table)
  15.   (modify-syntax-entry ?\( "()" table)
  16.   (modify-syntax-entry ?\) ")(" table)
  17.   (modify-syntax-entry ?$ "." table)
  18.   (modify-syntax-entry ?* "." table)
  19.   (modify-syntax-entry ?/ "." table)
  20.   (modify-syntax-entry ?+ "." table)
  21.   (modify-syntax-entry ?- "." table)
  22.   (modify-syntax-entry ?= "." table)
  23.   (modify-syntax-entry ?\& "." table)
  24.   (modify-syntax-entry ?\| "." table)
  25.   (modify-syntax-entry ?< "." table)
  26.   (modify-syntax-entry ?> "." table)
  27.   (modify-syntax-entry ?\[ "." table)
  28.   (modify-syntax-entry ?\] "." table)
  29.   (modify-syntax-entry ?\{ "." table)
  30.   (modify-syntax-entry ?\} "." table)
  31.   (modify-syntax-entry ?. "." table)
  32.   (modify-syntax-entry ?\\ "." table)
  33.   (modify-syntax-entry ?: "." table)
  34.   (modify-syntax-entry ?\; "." table)
  35.   (modify-syntax-entry ?\' "." table)
  36.   (modify-syntax-entry ?\" "\"" table)
  37.   (setq ada-mode-syntax-table table))
  38.  
  39. (defvar ada-mode-map nil
  40.   "Keymap used in Ada mode.")
  41.  
  42. (let ((map (make-sparse-keymap)))
  43.   (define-key map "\C-m" 'ada-newline)
  44.   (define-key map "\C-?" 'backward-delete-char-untabify)
  45.   (define-key map "\C-i" 'ada-tab)
  46.   (define-key map "\C-c\C-i" 'ada-untab)
  47.   (define-key map "\C-c<" 'ada-backward-to-same-indent)
  48.   (define-key map "\C-c>" 'ada-forward-to-same-indent)
  49.   (define-key map "\C-ch" 'ada-header)
  50.   (define-key map "\C-c(" 'ada-paired-parens)
  51.   (define-key map "\C-c-" 'ada-inline-comment)
  52.   (define-key map "\C-c\C-a" 'ada-array)
  53.   (define-key map "\C-cb" 'ada-exception-block)
  54.   (define-key map "\C-cd" 'ada-declare-block)
  55.   (define-key map "\C-c\C-e" 'ada-exception)
  56.   (define-key map "\C-cc" 'ada-case)
  57.   (define-key map "\C-c\C-k" 'ada-package-spec)
  58.   (define-key map "\C-ck" 'ada-package-body)
  59.   (define-key map "\C-c\C-p" 'ada-procedure-spec)
  60.   (define-key map "\C-cp" 'ada-subprogram-body)
  61.   (define-key map "\C-c\C-f" 'ada-function-spec)
  62.   (define-key map "\C-cf" 'ada-for-loop)
  63.   (define-key map "\C-cl" 'ada-loop)
  64.   (define-key map "\C-ci" 'ada-if)
  65.   (define-key map "\C-cI" 'ada-elsif)
  66.   (define-key map "\C-ce" 'ada-else)
  67.   (define-key map "\C-c\C-v" 'ada-private)
  68.   (define-key map "\C-c\C-r" 'ada-record)
  69.   (define-key map "\C-c\C-s" 'ada-subtype)
  70.   (define-key map "\C-cs" 'ada-separate)
  71.   (define-key map "\C-c\C-t" 'ada-type)
  72.   (define-key map "\C-ct" 'ada-tabsize)
  73. ;;    (define-key map "\C-c\C-u" 'ada-use)
  74. ;;    (define-key map "\C-c\C-w" 'ada-with)
  75.   (define-key map "\C-cw" 'ada-while-loop)
  76.   (define-key map "\C-c\C-w" 'ada-when)
  77.   (define-key map "\C-cx" 'ada-exit)
  78.   (define-key map "\C-cC" 'ada-compile)
  79.   (define-key map "\C-cB" 'ada-bind)
  80.   (define-key map "\C-cE" 'ada-find-listing)
  81.   (define-key map "\C-cL" 'ada-library-name)
  82.   (define-key map "\C-cO" 'ada-options-for-bind)
  83.   (setq ada-mode-map map))
  84.  
  85. (defvar ada-indent 4 "*Value is the number of columns to indent in Ada-Mode.")
  86.   
  87. (defun ada-mode ()
  88. "This is a mode intended to support program development in Ada.
  89. Most control constructs and declarations of Ada can be inserted in the buffer
  90. by typing Control-C followed by a character mnemonic for the construct.
  91.  
  92. C-c C-a  array             C-c b    exception block
  93. C-c C-e  exception      C-c d    declare block
  94. C-c C-k  package spec   C-c k    package body
  95. C-c C-p  procedure spec C-c p    proc/func body
  96. C-c C-f  func spec      C-c f    for loop
  97.                         C-c i    if
  98.                         C-c I    elsif
  99.                         C-c e    else
  100. C-c C-v  private        C-c l    loop
  101. C-c C-r  record         C-c c    case
  102. C-c C-s  subtype        C-c s    separate
  103. C-c C-t  type           C-c t    tab spacing for indents
  104. C-c C-w  when           C-c w    while
  105.                         C-c x    exit
  106. C-c (    paired parens  C-c -    inline comment
  107.                         C-c h    header sec
  108. C-c C    compile        C-c B    bind
  109. C-c E    find error list
  110. C-c L    name library   C-c O    options for bind
  111.  
  112. C-c < and C-c > move backward and forward respectively to the next line
  113. having the same (or lesser) level of indentation.
  114.  
  115. Variable ada-indent controls the number of spaces for indent/undent.
  116.  
  117. \\{ada-mode-map}
  118. "
  119.   (interactive)
  120.   (kill-all-local-variables)
  121.   (use-local-map ada-mode-map)
  122.   (setq major-mode 'ada-mode)
  123.   (setq mode-name "Ada")
  124.   (make-local-variable 'comment-column)
  125.   (setq comment-column 41)
  126.   (make-local-variable 'end-comment-column)
  127.   (setq end-comment-column 72)
  128.   (set-syntax-table ada-mode-syntax-table)
  129.   (make-local-variable 'paragraph-start)
  130.   (setq paragraph-start (concat "^$\\|" page-delimiter))
  131.   (make-local-variable 'paragraph-separate)
  132.   (setq paragraph-separate paragraph-start)
  133.   (make-local-variable 'paragraph-ignore-fill-prefix)
  134.   (setq paragraph-ignore-fill-prefix t)
  135. ;  (make-local-variable 'indent-line-function)
  136. ;  (setq indent-line-function 'c-indent-line)
  137.   (make-local-variable 'require-final-newline)
  138.   (setq require-final-newline t)
  139.   (make-local-variable 'comment-start)
  140.   (setq comment-start "--")
  141.   (make-local-variable 'comment-end)
  142.   (setq comment-end "\n")
  143.   (make-local-variable 'comment-column)
  144.   (setq comment-column 41)
  145.   (make-local-variable 'comment-start-skip)
  146.   (setq comment-start-skip "--+ *")
  147.   (make-local-variable 'comment-indent-hook)
  148.   (setq comment-indent-hook 'c-comment-indent)
  149.   (make-local-variable 'parse-sexp-ignore-comments)
  150.   (setq parse-sexp-ignore-comments t)
  151.   (run-hooks 'ada-mode-hook))
  152.  
  153. (defun ada-tabsize (s)
  154.   "changes spacing used for indentation. Reads spacing from minibuffer."
  155.   (interactive "nnew indentation spacing: ")
  156.   (setq ada-indent s))
  157.  
  158. (defun ada-newline ()
  159.   "Start new line and indent to current tab stop."
  160.   (interactive)
  161.   (let ((ada-cc (current-indentation)))
  162.     (newline)
  163.     (indent-to ada-cc)))
  164.  
  165. (defun ada-tab ()
  166.   "Indent to next tab stop."
  167.   (interactive)
  168.   (indent-to (* (1+ (/ (current-indentation) ada-indent)) ada-indent)))
  169.  
  170. (defun ada-untab ()
  171.   "Delete backwards to previous tab stop."
  172.   (interactive)
  173.   (backward-delete-char-untabify ada-indent nil))
  174.  
  175. (defun ada-go-to-this-indent (step indent-level)
  176.   "Move point repeatedly by <step> lines till the current line
  177. has given indent-level or less, or the start/end of the buffer is hit.
  178. Ignore blank lines, statement labels, block/loop names."
  179.   (while (and
  180.       (zerop (forward-line step))
  181.       (or (looking-at "^[     ]*$")
  182.           (looking-at "^[     ]*--")
  183.           (looking-at "^<<[A-Za-z0-9_]+>>")
  184.           (looking-at "^[A-Za-z0-9_]+:")
  185.           (> (current-indentation) indent-level)))
  186.     nil))
  187.  
  188. (defun ada-backward-to-same-indent ()
  189.   "Move point backwards to nearest line with same indentation or less.
  190. If not found, point is left at top of buffer."
  191.   (interactive)
  192.   (ada-go-to-this-indent -1 (current-indentation))
  193.   (back-to-indentation))
  194.  
  195. (defun ada-forward-to-same-indent ()
  196.   "Move point forwards to nearest line with same indentation or less.
  197. If not found, point is left at start of last line in buffer."
  198.   (interactive)
  199.   (ada-go-to-this-indent 1 (current-indentation))
  200.   (back-to-indentation))
  201.  
  202. (defun ada-array ()
  203.   "Insert array type definition, prompting for component type,
  204. leaving the user to type in the index subtypes."
  205.   (interactive)
  206.   (insert "array ()")
  207.   (backward-char)
  208.   (insert (read-string "index subtype[s]: "))
  209.   (end-of-line)
  210.   (insert " of ;")
  211.   (backward-char)
  212.   (insert (read-string "component-type: "))
  213.   (end-of-line))
  214.  
  215. (defun ada-case ()
  216.   "Build skeleton case statment, prompting for the selector expression.
  217. starts up the first when clause, too."
  218.   (interactive)
  219.   (insert "case ")
  220.   (insert (read-string "selector expression: ") " is")
  221.   (ada-newline)
  222.   (ada-newline)
  223.   (insert "end case;")
  224.   (end-of-line 0)
  225.   (ada-tab)
  226.   (ada-tab)
  227.   (ada-when))
  228.  
  229. (defun ada-declare-block ()
  230.   "Insert a block with a declare part and indent for the 1st declaration."
  231.   (interactive)
  232.   (let ((ada-block-name (read-string "[block name]: ")))
  233.     (insert "declare")
  234.     (cond
  235.       ( (not (string-equal ada-block-name ""))
  236.     (beginning-of-line)
  237.     (open-line 1)
  238.     (insert ada-block-name ":")
  239.     (next-line 1)
  240.     (end-of-line)))
  241.     (ada-newline)
  242.     (ada-newline)
  243.     (insert "begin")
  244.     (ada-newline)
  245.     (ada-newline)
  246.     (if (string-equal ada-block-name "")
  247.       (insert "end;")
  248.       (insert "end " ada-block-name ";"))
  249.    )
  250.   (end-of-line -2)
  251.   (ada-tab))
  252.  
  253. (defun ada-exception-block ()
  254.   "Insert a block with an exception part and indent for the 1st line of code."
  255.   (interactive)
  256.   (let ((block-name (read-string "[block name]: ")))
  257.     (insert "begin")
  258.     (cond
  259.       ( (not (string-equal block-name ""))
  260.     (beginning-of-line)
  261.     (open-line 1)
  262.     (insert block-name ":")
  263.     (next-line 1)
  264.     (end-of-line)))
  265.     (ada-newline)
  266.     (ada-newline)
  267.     (insert "exception")
  268.     (ada-newline)
  269.     (ada-newline)
  270.     (cond
  271.       ( (string-equal block-name "")
  272.     (insert "end;"))
  273.       ( t
  274.     (insert "end " block-name ";")))
  275.    )
  276.   (end-of-line -2)
  277.   (ada-tab))
  278.  
  279. (defun ada-exception ()
  280.   "Undent and insert an exception part into a block. Reindent."
  281.   (interactive)
  282.   (ada-untab)
  283.   (insert "exception")
  284.   (ada-newline)
  285.   (ada-tab))
  286.  
  287. (defun ada-else ()
  288.   "Add an else clause inside an if-then-end-if clause."
  289.   (interactive)
  290.   (ada-untab)
  291.   (insert "else")
  292.   (ada-newline)
  293.   (ada-tab))
  294.  
  295. (defun ada-exit ()
  296.   "Insert an exit statement, prompting for loop name and condition."
  297.   (interactive)
  298.   (insert "exit")
  299.   (let ((ada-loop-name (read-string "[name of loop to exit]: ")))
  300.     (if (not (string-equal ada-loop-name "")) (insert " " ada-loop-name)))
  301.   (let ((ada-exit-condition (read-string "[exit condition]: ")))
  302.     (if (not (string-equal ada-exit-condition ""))
  303.     (if (string-match "^ *[Ww][Hh][Ee][Nn] +" ada-exit-condition)
  304.         (insert " " ada-exit-condition)
  305.       (insert " when " ada-exit-condition))))
  306.   (insert ";"))
  307.  
  308. (defun ada-when ()
  309.   "Start a case statement alternative with a when clause."
  310.   (interactive)
  311.   (ada-untab)     ; we were indented in code for the last alternative.
  312.   (insert "when ")
  313.   (insert (read-string "'|'-delimited choice list: ") " =>")
  314.   (ada-newline)
  315.   (ada-tab))
  316.  
  317. (defun ada-for-loop ()
  318.   "Build a skeleton for-loop statement, prompting for the loop parameters."
  319.   (interactive)
  320.   (insert "for ")
  321.   (let* ((ada-loop-name (read-string "[loop name]: "))
  322.      (ada-loop-is-named (not (string-equal ada-loop-name ""))))
  323.     (if ada-loop-is-named
  324.     (progn
  325.       (beginning-of-line)
  326.       (open-line 1)
  327.       (insert ada-loop-name ":")
  328.       (next-line 1)
  329.       (end-of-line 1)))
  330.     (insert (read-string "loop variable: ") " in ")
  331.     (insert (read-string "range: ") " loop")
  332.     (ada-newline)
  333.     (ada-newline)
  334.     (insert "end loop")
  335.     (if ada-loop-is-named (insert " " ada-loop-name))
  336.     (insert ";"))
  337.   (end-of-line 0)
  338.   (ada-tab))
  339.  
  340. (defun ada-header ()
  341.   "Insert a comment block containing the module title, author, etc."
  342.   (interactive)
  343.   (insert "--\n--  Title: \t")
  344.   (insert (read-string "Title: "))
  345.   (insert "\n--  Created:\t" (current-time-string))
  346.   (insert "\n--  Author: \t" (user-full-name))
  347.   (insert "\n--\t\t<" (user-login-name) "@" (system-name) ">\n--\n"))
  348.  
  349. (defun ada-if ()
  350.   "Insert skeleton if statment, prompting for a boolean-expression."
  351.   (interactive)
  352.   (insert "if ")
  353.   (insert (read-string "condition: ") " then")
  354.   (ada-newline)
  355.   (ada-newline)
  356.   (insert "end if;")
  357.   (end-of-line 0)
  358.   (ada-tab))
  359.  
  360. (defun ada-elsif ()
  361.   "Add an elsif clause to an if statement, prompting for the boolean-expression."
  362.   (interactive)
  363.   (ada-untab)
  364.   (insert "elsif ")
  365.   (insert (read-string "condition: ") " then")
  366.   (ada-newline)
  367.   (ada-tab))
  368.  
  369. (defun ada-loop ()
  370.   "insert a skeleton loop statement.  exit statement added by hand."
  371.   (interactive)
  372.   (insert "loop ")
  373.   (let* ((ada-loop-name (read-string "[loop name]: "))
  374.      (ada-loop-is-named (not (string-equal ada-loop-name ""))))
  375.     (if ada-loop-is-named
  376.     (progn
  377.       (beginning-of-line)
  378.       (open-line 1)
  379.       (insert ada-loop-name ":")
  380.       (forward-line 1)
  381.       (end-of-line 1)))
  382.     (ada-newline)
  383.     (ada-newline)
  384.     (insert "end loop")
  385.     (if ada-loop-is-named (insert " " ada-loop-name))
  386.     (insert ";"))
  387.   (end-of-line 0)
  388.   (ada-tab))
  389.  
  390. (defun ada-package-spec ()
  391.   "Insert a skeleton package specification."
  392.   (interactive)
  393.   (insert "package ")
  394.   (let ((ada-package-name (read-string "package name: " )))
  395.     (insert ada-package-name " is")
  396.     (ada-newline)
  397.     (ada-newline)
  398.     (insert "end " ada-package-name ";")
  399.     (end-of-line 0)
  400.     (ada-tab)))
  401.  
  402. (defun ada-package-body ()
  403.   "Insert a skeleton package body --  includes a begin statement."
  404.   (interactive)
  405.   (insert "package body ")
  406.   (let ((ada-package-name (read-string "package name: " )))
  407.     (insert ada-package-name " is")
  408.     (ada-newline)
  409.     (ada-newline)
  410.     (insert "begin")
  411.     (ada-newline)
  412.     (insert "end " ada-package-name ";")
  413.     (end-of-line -1)
  414.     (ada-tab)))
  415.  
  416. (defun ada-private ()
  417.   "Undent and start a private section of a package spec. Reindent."
  418.   (interactive)
  419.   (ada-untab)
  420.   (insert "private")
  421.   (ada-newline)
  422.   (ada-tab))
  423.  
  424. (defun ada-get-arg-list ()
  425.   "Read from user a procedure or function argument list.
  426. Add parens unless arguments absent, and insert into buffer.
  427. Individual arguments are arranged vertically if entered one-at-a-time.
  428. Arguments ending with ';' are presumed single and stacked."
  429.   (insert " (")
  430.   (let ((ada-arg-indent (current-column))
  431.     (ada-args (read-string "[arguments]: ")))
  432.     (if (string-equal ada-args "")
  433.     (backward-delete-char 2)
  434.       (progn
  435.     (while (string-match ";$" ada-args)
  436.       (insert ada-args)
  437.       (newline)
  438.       (indent-to ada-arg-indent)
  439.       (setq ada-args (read-string "next argument: ")))
  440.     (insert ada-args ")")))))
  441.  
  442. (defun ada-function-spec ()
  443.   "Insert a function specification.  Prompts for name and arguments."
  444.   (interactive)
  445.   (insert "function ")
  446.   (insert (read-string "function name: "))
  447.   (ada-get-arg-list)
  448.   (insert " return ")
  449.   (insert (read-string "result type: ")))
  450.  
  451. (defun ada-procedure-spec ()
  452.   "Insert a procedure specification, prompting for its name and arguments."
  453.   (interactive)
  454.   (insert "procedure ")
  455.   (insert (read-string "procedure name: " ))
  456.   (ada-get-arg-list))
  457.  
  458. (defun get-ada-subprogram-name ()
  459.   "Return (without moving point or mark) a pair whose CAR is
  460. the name of the function or procedure whose spec immediately precedes point,
  461. and whose CDR is the column nbr the procedure/function keyword was found at."
  462.   (save-excursion
  463.     (let ((ada-proc-indent 0))
  464.       (if (re-search-backward
  465.   ;;;; Unfortunately, comments are not ignored in this string search.
  466.          "[PpFf][RrUu][OoNn][Cc][EeTt][DdIi][UuOo][RrNn]" nil t)
  467.       (if (or (looking-at "\\<[Pp][Rr][Oo][Cc][Ee][Dd][Uu][Rr][Ee]\\>")
  468.           (looking-at "\\<[Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\>"))
  469.           (progn
  470.         (setq ada-proc-indent (current-column))
  471.         (forward-word 2)
  472.         (let ((p2 (point)))
  473.           (forward-word -1)
  474.           (cons (buffer-substring (point) p2) ada-proc-indent)))
  475.           (get-ada-subprogram-name))
  476.        (cons "NAME?" ada-proc-indent)))))
  477.  
  478. (defun ada-subprogram-body ()
  479.   "Insert frame for subprogram body.
  480. Invoke right after ada-function-spec or ada-procedure-spec."
  481.   (interactive)
  482.   (insert " is")
  483.   (let ((ada-subprogram-name-col (get-ada-subprogram-name)))
  484.     (newline)
  485.     (indent-to (cdr ada-subprogram-name-col))
  486.     (ada-newline)
  487.     (insert "begin")
  488.     (ada-newline)
  489.     (ada-newline)
  490.     (insert "end " (car ada-subprogram-name-col) ";"))
  491.   (end-of-line -2)
  492.   (ada-tab))
  493.  
  494. (defun ada-separate ()
  495.   "Finish a body stub with 'is separate'."
  496.   (interactive)
  497.   (insert " is")
  498.   (ada-newline)
  499.   (ada-tab)
  500.   (insert "separate;")
  501.   (ada-newline)
  502.   (ada-untab))
  503.  
  504. ;(defun ada-with ()
  505. ;  "Inserts a with clause, prompting for the list of units depended upon."
  506. ;  (interactive)
  507. ;  (insert "with ")
  508. ;  (insert (read-string "list of units depended upon: ") ";"))
  509. ;
  510. ;(defun ada-use ()
  511. ;  "Inserts a use clause, prompting for the list of packages used."
  512. ;  (interactive)
  513. ;  (insert "use ")
  514. ;  (insert (read-string "list of packages to use: ") ";"))
  515.  
  516. (defun ada-record ()
  517.   "Insert a skeleton record type declaration."
  518.   (interactive)
  519.   (insert "record")
  520.   (ada-newline)
  521.   (ada-newline)
  522.   (insert "end record;")
  523.   (end-of-line 0)
  524.   (ada-tab))
  525.  
  526. (defun ada-subtype ()
  527.   "Start insertion of a subtype declaration, prompting for the subtype name."
  528.   (interactive)
  529.   (insert "subtype " (read-string "subtype name: ") " is ;")
  530.   (backward-char)
  531.   (message "insert subtype indication."))
  532.  
  533. (defun ada-type ()
  534.   "Start insertion of a type declaration, prompting for the type name."
  535.   (interactive)
  536.   (insert "type " (read-string "type name: "))
  537.   (let ((disc-part (read-string "discriminant specs: ")))
  538.     (if (not (string-equal disc-part ""))
  539.     (insert "(" disc-part ")")))
  540.   (insert " is ")
  541.   (message "insert type definition."))
  542.  
  543. (defun ada-while-loop ()
  544.   (interactive)
  545.   (insert "while ")
  546.   (let* ((ada-loop-name (read-string "loop name: "))
  547.      (ada-loop-is-named (not (string-equal ada-loop-name ""))))
  548.     (if ada-loop-is-named
  549.     (progn
  550.       (beginning-of-line)
  551.       (open-line 1)
  552.       (insert ada-loop-name ":")
  553.       (next-line 1)
  554.       (end-of-line 1)))
  555.     (insert (read-string "entry condition: ") " loop")
  556.     (ada-newline)
  557.     (ada-newline)
  558.     (insert "end loop")
  559.     (if ada-loop-is-named (insert " " ada-loop-name))
  560.     (insert ";"))
  561.   (end-of-line 0)
  562.   (ada-tab))
  563.  
  564. (defun ada-paired-parens ()
  565.   "Insert a pair of round parentheses, placing point between them."
  566.   (interactive)
  567.   (insert "()")
  568.   (backward-char))
  569.  
  570. (defun ada-inline-comment ()
  571.   "Start a comment after the end of the line, indented at least COMMENT-COLUMN.
  572. If starting after END-COMMENT-COLUMN, start a new line."
  573.   (interactive)
  574.   (end-of-line)
  575.   (if (> (current-column) end-comment-column) (newline))
  576.   (if (< (current-column) comment-column) (indent-to comment-column))
  577.   (insert " -- "))
  578.  
  579. (defun ada-display-comment ()
  580. "Inserts 3 comment lines, making a display comment."
  581.   (interactive)
  582.   (insert "--\n-- \n--")
  583.   (end-of-line 0))
  584.  
  585. ;; Much of this is specific to Ada-Ed
  586.  
  587. (defvar ada-lib-dir-name "lib" "*Current ada program library directory.")
  588. (defvar ada-bind-opts "" "*Options to supply for binding.")
  589.  
  590. (defun ada-library-name (ada-lib-name)
  591.   "Specify name of ada library directory for later compilations."
  592.   (interactive "Dname of ada library directory: ")
  593.   (setq ada-lib-dir-name ada-lib-name))
  594.  
  595. (defun ada-options-for-bind ()
  596.   "Specify options, such as -m and -i, needed for adabind."
  597.   (setq ada-bind-opts (read-string "-m and -i options for adabind: ")))
  598.  
  599. (defun ada-compile (ada-prefix-arg)
  600.   "Save the current buffer and compile it into the current program library.
  601. Initialize the library if a prefix arg is given."
  602.   (interactive "P")
  603.   (let* ((ada-init (if (null ada-prefix-arg) "" "-n "))
  604.     (ada-source-file (buffer-name)))
  605.     (compile
  606.      (concat "adacomp " ada-init "-l " ada-lib-dir-name " " ada-source-file))))
  607.  
  608. (defun ada-find-listing ()
  609.   "Find listing file for ada source in current buffer, using other window."
  610.   (interactive)
  611.   (find-file-other-window (concat (substring (buffer-name) 0 -4) ".lis"))
  612.   (search-forward "*** ERROR"))
  613.  
  614. (defun ada-bind ()
  615.   "Bind the current program library, using the current binding options."
  616.   (interactive)
  617.   (compile (concat "adabind " ada-bind-opts " " ada-lib-dir-name)))
  618.